﻿(*******************************************************************************
  TWordExport Word文档报告输出类
================================================================================
  通过 RegTable(Prefix: string; ADataSet: TCustomADODataSet; IsTable: Boolean);
  注册查询结果和展现方式，IsTable=false 非表格数据插入，IsTable=True 为表格自动
  扩展数据插入，表格数据的前缀为表格序号。
  with TWordExport.Create do try
    RegTable('A', ADOTable1, False);
    RegTable('1', ADOTable2, True);               //第一个表格
    New('F:\VonApplications\Test\购货单位.dotx');
    WriteData;
    SaveFile();
  finally
    Free;
  end;
--------------------------------------------------------------------------------

*******************************************************************************)
unit UWordExport;

interface

uses SysUtils, Variants, Classes, Graphics, Controls, OLE_Word_TLB, ComObj,
  StdCtrls, ADODB, DB, UVonLog, UVonConfig;

type
  TWordExport = class
  private
    FWordApp: TWordApplication;
    FWordBook: TWordDocument;
    FFilename: OleVariant;
    FRegistList: TStringList;
    FOpened: Boolean;
    FSetted: Boolean;
    procedure WriteTextData(Prefix: string; ADataSet: TCustomADODataSet);
    procedure WriteTableData(Prefix: string; ADataSet: TCustomADODataSet);
    function GetCurrentBook: TWordDocument;
  public
    constructor Create;
    destructor Destroy;
    /// <summary>注册外部数据源</summary>
    /// <param name="Prefix">合并域前缀，表格数据为表格序号</param>
    /// <param name="ADataSet">数据源</param>
    /// <param name="IsTable">是否是表格数据</param>
    procedure RegTable(Prefix: string; ADataSet: TCustomADODataSet; IsTable: Boolean);
    /// <summary>打开一个Word文档</summary>
    procedure Open(Filename: string);
    /// <summary>通过Word模板新建一个文件</summary>
    procedure New(Filename: string);
    /// <summary>打印当前文件</summary>
    procedure Print;
    /// <summary>另存当前文件，如文件名不写则表示用原文件名存储</summary>
    procedure SaveFile(Filename: string = '');
    /// <summary>关闭当前word文档</summary>
    procedure Close;
    /// <summary>开始写入注册数据</summary>
    procedure WriteData;
    procedure WriteVonTableData(TableIdx: Integer; Table: TVonTable);
  published
    /// <summary>文件是否已经打开</summary>
    property Opened: Boolean read FOpened;
    /// <summary>数据源是否已经注册</summary>
    property Setted: Boolean read FSetted;
    /// <summary>当前工作本</summary>
    property CurrentBook: TWordDocument read GetCurrentBook;
  end;

implementation

{ TWordExport }

procedure TWordExport.Close;
begin
  if not FOpened then Exit;
  FWordBook.Close;
  FOpened:= False;
end;

constructor TWordExport.Create;
begin
  FRegistList:= TStringList.Create;
  FWordApp:= TWordApplication.Create(nil);
  FWordBook:= TWordDocument.Create(nil);
end;

destructor TWordExport.Destroy;
begin
  FWordBook.Free;
  FWordApp.Free;
  FRegistList.Free;
end;

function TWordExport.GetCurrentBook: TWordDocument;
begin
  Result:= FWordBook;
end;

procedure TWordExport.New(Filename: string);
begin
  FFilename:= Filename;
  FWordApp.Connect;
  FWordApp.Visible:= True;
  FWordBook.ConnectTo(FWordApp.Documents.Add(FFilename, EmptyParam, EmptyParam, EmptyParam));
  FFilename:= ChangeFileExt(Filename, '.doc');
  FOpened:= True;
end;

procedure TWordExport.Open(Filename: string);
begin
  FFilename:= Filename;
  FWordApp.Connect;
  FWordApp.Visible:= True;
  FWordBook.ConnectTo(FWordApp.Documents.Open(FFilename, EmptyParam, EmptyParam,
    EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
    EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam));
  FOpened:= True;
end;

procedure TWordExport.Print;
begin
  if not FOpened then Exit;
  FWordBook.PrintPreview;
end;

procedure TWordExport.RegTable(Prefix: string; ADataSet: TCustomADODataSet;
  IsTable: Boolean);
begin
  if IsTable then FRegistList.AddObject(Prefix + '=1', ADataSet)
  else FRegistList.AddObject(Prefix + '=0', ADataSet);
  FSetted:= True;
end;

procedure TWordExport.SaveFile(Filename: string);
begin
  if not FOpened then Exit;
  if Filename <> '' then FFilename:= Filename;
  FWordBook.SaveAs(FFilename);
end;

procedure TWordExport.WriteData;
var
  I: Integer;
begin
  if not Opened then Exit;
  if not Setted then Exit;
  for I := 0 to FRegistList.Count - 1 do
    case StrToInt(FRegistList.ValueFromIndex[I]) of
    0:  WriteTextData(FRegistList.Names[I], TCustomADODataSet(FRegistList.Objects[I]));
    1:  WriteTableData(FRegistList.Names[I], TCustomADODataSet(FRegistList.Objects[I]));
    end;
end;

procedure TWordExport.WriteTableData(Prefix: string;
  ADataSet: TCustomADODataSet);
var
  I, R, C, lenPrefix: Integer;
  Expanded: Boolean;
  fldName, fldPrefix: string;
  szRow: OleVariant;
begin
  R := 0;
  with FWordBook.Tables.Item(StrToInt(Prefix)) do begin
    while not ADataSet.EOF do begin
      Expanded:= False;
      for C := 1 to Columns.Count do begin
        if R = 0 then begin     //寻找第一个数据行号
          I:= 0;
          while I < Rows.Count do
            if Cell(I + 1, C).Range.Fields.Count = 0 then Inc(I)
            else begin R:= I + 1; System.break; end;
        end;
        if Cell(R, C).Range.Fields.Count = 0 then Continue;
        lenPrefix:= Length(Prefix);                       //«A_Delivery»
        fldPrefix:= Cell(R, C).Range.Fields.Item(1).Result.Text;
        fldName:= System.Copy(fldPrefix, lenPrefix + 3, Length(fldPrefix) - lenPrefix - 3);
        fldPrefix:= System.Copy(fldPrefix, 2, lenPrefix);
        if fldPrefix = Prefix then begin
          if not Expanded then begin
            Expanded:= True;
            szRow:= Rows.Item(R);
            Rows.Add(szRow);
            Inc(R);
          end;
          Cell(R - 1, C).Range.Text:= ADataSet.FieldByName(fldName).AsString;
        end;
      end;
      ADataSet.Next;
    end;
    if R > 0 then
      Rows.Item(R).Delete;
  end;
end;

procedure TWordExport.WriteTextData(Prefix: string;
  ADataSet: TCustomADODataSet);
var
  I, lenPrefix: Integer;
  FieldCode: string;
begin
  for I := 1 to FWordBook.Fields.Count do
    with FWordBook.Fields.Item(I) do begin
      lenPrefix:= Length(Prefix);                       //«A_Delivery»
      FieldCode:= System.Copy(Result.Text, lenPrefix + 3, Length(Result.Text) - lenPrefix - 3);
      if System.Copy(Result.Text, 2, lenPrefix) = Prefix then
        Result.Text:= ADataSet.FieldByName(FieldCode).AsString;
  end;
end;

procedure TWordExport.WriteVonTableData(TableIdx: Integer; Table: TVonTable);
var
  I, J, R, C, fldIdx: Integer;
  Expanded: Boolean;
  fld: string;
  szRow: OleVariant;
begin
  R := 0;
  with FWordBook.Tables.Item(TableIdx) do begin
    for J:= 0 to Table.RowCount - 1 do begin
      Expanded:= False;
      for C := 1 to Columns.Count do begin
        if R = 0 then begin     //寻找第一个数据行号
          I:= 0;
          while I < Rows.Count do
            if Cell(I + 1, C).Range.Fields.Count = 0 then Inc(I)
            else begin R:= I + 1; System.break; end;
        end;
        if Cell(R, C).Range.Fields.Count = 0 then Continue;
        fld:= Cell(R, C).Range.Fields.Item(1).Result.Text;
        fldIdx:= StrToInt(Copy(fld, 2, Length(fld) - 2));
        if not Expanded then begin
          Expanded:= True;
          szRow:= Rows.Item(R);
          Rows.Add(szRow);
          Inc(R);
        end;
        Cell(R - 1, C).Range.Text:= Table.Cells[fldIdx, J];
      end;
    end;
    if R > 0 then
      Rows.Item(R).Delete;
  end;
end;

end.
